home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / prim / minibuf.el < prev    next >
Encoding:
Text File  |  1995-08-15  |  69.2 KB  |  1,708 lines
  1. ;;; minibuf.el
  2. ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
  3. ;; Copyright (C) 1995 Tinker Systems
  4.  
  5. ;; This file is part of XEmacs.
  6.  
  7. ;; XEmacs is free software; you can redistribute it and/or modify it
  8. ;; under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 2, or (at your option)
  10. ;; any later version.
  11.  
  12. ;; XEmacs is distributed in the hope that it will be useful, but
  13. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. ;; General Public License for more details.
  16.  
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  19. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21. ;; Written by Richard Mlynarik 2-Oct-92
  22.  
  23. (defvar insert-default-directory t
  24.  "*Non-nil means when reading a filename start with default dir in minibuffer."
  25.  )
  26.  
  27. (defvar minibuffer-completion-table nil
  28.   "Alist or obarray used for completion in the minibuffer.
  29. This becomes the ALIST argument to `try-completion' and `all-completions'.
  30.  
  31. The value may alternatively be a function, which is given three arguments:
  32.   STRING, the current buffer contents;
  33.   PREDICATE, the predicate for filtering possible matches;
  34.   CODE, which says what kind of things to do.
  35. CODE can be nil, t or `lambda'.
  36. nil means to return the best completion of STRING, nil if there is none,
  37.   or t if it is was already a unique completion.
  38. t means to return a list of all possible completions of STRING.
  39. `lambda' means to return t if STRING is a valid completion as it stands.")
  40.  
  41. (defvar minibuffer-completion-predicate nil
  42.   "Within call to `completing-read', this holds the PREDICATE argument.")
  43.  
  44. (defvar minibuffer-completion-confirm nil
  45.   "Non-nil => demand confirmation of completion before exiting minibuffer.")
  46.  
  47. (defvar minibuffer-confirm-incomplete nil
  48.   "If true, then in contexts where completing-read allows answers which
  49. are not valid completions, an extra RET must be typed to confirm the
  50. response.  This is helpful for catching typos, etc.")
  51.  
  52. (defvar completion-auto-help t
  53.   "*Non-nil means automatically provide help for invalid completion input.")
  54.  
  55. (defvar enable-recursive-minibuffers nil
  56.   "*Non-nil means to allow minibuffer commands while in the minibuffer.
  57. More precisely, this variable makes a difference when the minibuffer window
  58. is the selected window.  If you are in some other window, minibuffer commands
  59. are allowed even if a minibuffer is active.")
  60.  
  61. (defvar minibuffer-max-depth 1
  62.   ;; See comment in #'minibuffer-max-depth-exceeded
  63.   "*Global maximum number of minibuffers allowed;
  64. compare to enable-recursive-minibuffers, which is only consulted when the
  65. minibuffer is reinvoked while it is the selected window.")
  66.  
  67. ;; Moved to C.  The minibuffer prompt must be setup before this is run
  68. ;; and that can only be done from the C side.
  69. ;(defvar minibuffer-setup-hook nil
  70. ;  "Normal hook run just after entry to minibuffer.")
  71.  
  72. (defvar minibuffer-exit-hook nil
  73.   "Normal hook run just after exit from minibuffer.")
  74.  
  75. (defvar minibuffer-help-form nil
  76.   "Value that `help-form' takes on inside the minibuffer.")
  77.  
  78. (defvar minibuffer-local-map
  79.   (let ((map (make-sparse-keymap)))
  80.     (set-keymap-name map 'minibuffer-local-map)
  81.     map)
  82.   "Default keymap to use when reading from the minibuffer.")
  83.  
  84. (defvar minibuffer-local-completion-map
  85.   (let ((map (make-sparse-keymap)))
  86.     (set-keymap-name map 'minibuffer-local-completion-map)
  87.     (set-keymap-parents map (list minibuffer-local-map))
  88.     map)
  89.   "Local keymap for minibuffer input with completion.")
  90.  
  91. (defvar minibuffer-local-must-match-map
  92.   (let ((map (make-sparse-keymap)))
  93.     (set-keymap-name map 'minibuffer-must-match-map)
  94.     (set-keymap-parents map (list minibuffer-local-completion-map))
  95.     map)
  96.   "Local keymap for minibuffer input with completion, for exact match.")
  97.  
  98. ;; (define-key minibuffer-local-map "\C-g" 'abort-recursive-edit)
  99. (define-key minibuffer-local-map "\C-g" 'minibuffer-keyboard-quit) ;; moved here from pending-del.el
  100. (define-key minibuffer-local-map "\r" 'exit-minibuffer)
  101. (define-key minibuffer-local-map "\n" 'exit-minibuffer)
  102.  
  103. ;; Historical crock.  Unused by anything but user code, if even that
  104. ;(defvar minibuffer-local-ns-map
  105. ;  (let ((map (make-sparse-keymap)))
  106. ;    (set-keymap-name map 'minibuffer-local-ns-map)
  107. ;    (set-keymap-parents map (list minibuffer-local-map))
  108. ;    map)
  109. ;  "Local keymap for the minibuffer when spaces are not allowed.")
  110. ;(define-key minibuffer-local-ns-map [space] 'exit-minibuffer)
  111. ;(define-key minibuffer-local-ns-map [tab] 'exit-minibuffer)
  112. ;(define-key minibuffer-local-ns-map [?\?] 'self-insert-and-exit)
  113.  
  114. (define-key minibuffer-local-completion-map "\t" 'minibuffer-complete)
  115. (define-key minibuffer-local-completion-map " " 'minibuffer-complete-word)
  116. (define-key minibuffer-local-completion-map "?" 'minibuffer-completion-help)
  117. (define-key minibuffer-local-must-match-map "\r" 'minibuffer-complete-and-exit)
  118. (define-key minibuffer-local-must-match-map "\n" 'minibuffer-complete-and-exit)
  119.  
  120. (define-key minibuffer-local-map "\M-n" 'next-history-element)
  121. (define-key minibuffer-local-map "\M-p" 'previous-history-element)
  122. (define-key minibuffer-local-map '[next]  "\M-n")
  123. (define-key minibuffer-local-map '[prior] "\M-p")
  124. (define-key minibuffer-local-map "\M-r" 'previous-matching-history-element)
  125. (define-key minibuffer-local-map "\M-s" 'next-matching-history-element)
  126. (define-key minibuffer-local-must-match-map [next] 
  127.   'next-complete-history-element)
  128. (define-key minibuffer-local-must-match-map [prior]
  129.   'previous-complete-history-element)
  130.  
  131. (defvar read-expression-map (let ((map (make-sparse-keymap)))
  132.                               (set-keymap-parents map
  133.                           (list minibuffer-local-map))
  134.                   (set-keymap-name map 'read-expression-map)
  135.                               (define-key map "\M-\t" 'lisp-complete-symbol)
  136.                               map)
  137.   "Minibuffer keymap used for reading Lisp expressions.")
  138.  
  139. (defvar read-shell-command-map
  140.   (let ((map (make-sparse-keymap)))
  141.     (set-keymap-parents map (list minibuffer-local-map))
  142.     (set-keymap-name map 'read-shell-command-map)
  143.     (define-key map "\t" 'comint-dynamic-complete)
  144.     (define-key map "\M-\t" 'comint-dynamic-complete)
  145.     (define-key map "\M-?" 'comint-dynamic-list-completions)
  146.     map)
  147.   "Minibuffer keymap used by shell-command and related commands.")
  148.  
  149. (defun minibuffer-electric-slash ()
  150.   ;; by Stig@hackvan.com
  151.   (interactive)
  152.   (and (eq ?/ (preceding-char))
  153.        (not (eq (point) (1+ (point-min)))) ; permit `//hostname/path/to/file'
  154.        (not (eq ?: (char-after (- (point) 2))))    ; permit `http://url/goes/here'
  155.        (delete-region (point-min) (point)))
  156.   (insert ?/))
  157.  
  158. (defvar read-file-name-map
  159.   (let ((map (make-sparse-keymap)))
  160.     (set-keymap-parents map (list minibuffer-local-completion-map))
  161.     (set-keymap-name map 'read-file-name-map)
  162.     (define-key map "/" 'minibuffer-electric-slash)
  163.     map
  164.     ))
  165.  
  166. (defvar read-file-name-must-match-map
  167.   (let ((map (make-sparse-keymap)))
  168.     (set-keymap-parents map (list minibuffer-local-must-match-map))
  169.     (set-keymap-name map 'read-file-name-map)
  170.     (define-key map "/" 'minibuffer-electric-slash)
  171.     map
  172.     ))
  173.  
  174. (defun minibuffer-keyboard-quit ()
  175.   "Abort recursive edit.
  176. If `zmacs-regions' is true, and the zmacs region is active, then this
  177. key deactivates the region without beeping."
  178.   (interactive)
  179.   (if (and zmacs-regions (zmacs-deactivate-region))
  180.       ;; pseudo-zmacs compatibility: don't beep if this ^G is simply
  181.       ;; deactivating the region.  If it is inactive, beep.
  182.       nil
  183.     (abort-recursive-edit)))
  184.  
  185. ;;;#### Are the next/previous-window args correct for XEmacs??
  186. (defun minibuffer-window-active-p (window)
  187.   "Return t if WINDOW (a minibuffer window) is now active."
  188.   ;; nil nil means include WINDOW's frame
  189.   ;; and other frames using WINDOW as minibuffer,
  190.   ;; and include minibuffer if active.
  191.   (let ((prev (previous-window window nil nil)))
  192.     ;; If PREV equals WINDOW, WINDOW must be on a minibuffer-only frame
  193.     ;; and it's not currently being used.  So return nil.
  194.     (and (not (eq window prev))
  195.      (let ((should-be-same (next-window prev nil nil)))
  196.        ;; If next-window doesn't reverse previous-window,
  197.        ;; WINDOW must be outside the cycle specified by nil nil.
  198.        (eq should-be-same window)))))
  199.  
  200. ;;;; Guts of minibuffer invocation
  201.  
  202. ;;#### The only things remaining in C are
  203. ;; "Vminibuf_prompt" and the display junk
  204. ;;  "minibuf_prompt_width" and "minibuf_prompt_pix_width"
  205. ;; Also "active_frame", though I suspect I could already
  206. ;;   hack that in Lisp if I could make any sense of the
  207. ;;   complete mess of frame/frame code in XEmacs.
  208. ;; Vminibuf_prompt could easily be made Lisp-bindable.
  209. ;;  I suspect that minibuf_prompt*_width are actually recomputed
  210. ;;  by redisplay as needed -- or could be arranged to be so --
  211. ;;  and that there could be need for read-minibuffer-internal to
  212. ;;  save and restore them.
  213. ;;#### The only other thing which read-from-minibuffer-internal does
  214. ;;  which we can't presently do in Lisp is move the frame cursor
  215. ;;  to the start of the minibuffer line as it returns.  This is
  216. ;;  a rather nice touch and should be preserved -- probably by
  217. ;;  providing some Lisp-level mechanism (extension to cursor-in-echo-area ?)
  218. ;;  to effect it.
  219.  
  220.  
  221. ;; Like reset_buffer in FSF's buffer.c
  222. ;;  (Except that kill-all-local-variables doesn't nuke 'permanent-local
  223. ;;   variables -- we preserve them, reset_buffer doesn't.)
  224. (defun reset-buffer (buffer)
  225.   (save-excursion
  226.     (set-buffer buffer)
  227.     ;(if (fboundp 'unlock-buffer) (unlock-buffer))
  228.     (kill-all-local-variables)
  229.     (setq buffer-read-only nil)
  230.     (erase-buffer)
  231.     ;(setq default-directory nil)
  232.     (setq buffer-file-name nil)
  233.     (setq buffer-file-truename nil)
  234.     (set-buffer-modified-p nil)
  235.     (setq buffer-backed-up nil)
  236.     (setq buffer-auto-save-file-name nil)
  237.     (set-buffer-dedicated-frame buffer nil)
  238.     buffer))
  239.  
  240. (defvar minibuffer-history-variable 'minibuffer-history
  241.   "History list symbol to add minibuffer values to.
  242. Each minibuffer output is added with
  243.   (set minibuffer-history-variable
  244.        (cons STRING (symbol-value minibuffer-history-variable)))")
  245. (defvar minibuffer-history-position)
  246.  
  247. (defvar minibuffer-history-minimum-string-length 3
  248.   "If this variable is non-nil, a string will not be added to the
  249. minibuffer history if its length is less than that value.")
  250.  
  251. (defun read-from-minibuffer (prompt &optional initial-contents
  252.                                     keymap
  253.                                     readp
  254.                                     history
  255.                     abbrev-table)
  256.   "Read a string from the minibuffer, prompting with string PROMPT.
  257. If optional second arg INITIAL-CONTENTS is non-nil, it is a string
  258.   to be inserted into the minibuffer before reading input.
  259.   If INITIAL-CONTENTS is (STRING . POSITION), the initial input
  260.   is STRING, but point is placed POSITION characters into the string.
  261. Third arg KEYMAP is a keymap to use whilst reading;
  262.   if omitted or nil, the default is `minibuffer-local-map'.
  263. If fourth arg READ is non-nil, then interpret the result as a lisp object
  264.   and return that object:
  265.   in other words, do `(car (read-from-string INPUT-STRING))'
  266. Fifth arg HISTORY, if non-nil, specifies a history list
  267.   and optionally the initial position in the list.
  268.   It can be a symbol, which is the history list variable to use,
  269.   or it can be a cons cell (HISTVAR . HISTPOS).
  270.   In that case, HISTVAR is the history list variable to use,
  271.   and HISTPOS is the initial position (the position in the list
  272.   which INITIAL-CONTENTS corresponds to).
  273.   If HISTORY is `t', no history will be recorded.
  274.   Positions are counted starting from 1 at the beginning of the list.
  275. Sixth arg ABBREV-TABLE, if non-nil, becomes the value of `local-abbrev-table'
  276.   in the minibuffer.
  277.  
  278. See also the variable completion-highlight-first-word-only for control over completion display"
  279.   (if (and (not enable-recursive-minibuffers)
  280.            (> (minibuffer-depth) 0)
  281.            (eq (selected-window) (minibuffer-window)))
  282.       (error "Command attempted to use minibuffer while in minibuffer"))
  283.  
  284.   (if (and minibuffer-max-depth
  285.        (> minibuffer-max-depth 0)
  286.            (>= (minibuffer-depth) minibuffer-max-depth))
  287.       (minibuffer-max-depth-exceeded))
  288.  
  289.   ;; catch this error before the poor user has typed something...
  290.   (if history
  291.       (if (symbolp history)
  292.       (or (boundp history)
  293.           (error "History list %S is unbound" history))
  294.     (or (boundp (car history))
  295.         (error "History list %S is unbound" (car history)))))
  296.  
  297.   (if (noninteractive)
  298.       (progn
  299.         ;; XEmacs in -batch mode calls minibuffer: print the prompt.
  300.         (message "%s" (gettext prompt))
  301.         ;;#### force-output
  302.  
  303.         ;;#### Should this even be falling though to the code below?
  304.         ;;#### How does this stuff work now, anyway?
  305.         ))
  306.   (let* ((dir default-directory)
  307.          (owindow (selected-window))
  308.          (window (minibuffer-window))
  309.          (buffer (if (eq (minibuffer-depth) 0)
  310.                      (window-buffer window)
  311.                      (get-buffer-create (format " *Minibuf-%d"
  312.                                                 (minibuffer-depth)))))
  313.          (frame (window-frame window))
  314.          (mconfig (if (eq frame (selected-frame)) 
  315.                       nil (current-window-configuration frame)))
  316.          (oconfig (current-window-configuration))
  317.      ;; dynamic scope sucks sucks sucks sucks sucks sucks.
  318.      ;; `M-x doctor' makes history a local variable, and thus
  319.      ;; our binding above is buffer-local and doesn't apply
  320.      ;; once we switch buffers!!!!  We demand better scope!
  321.      (_history_ history))
  322.     (unwind-protect
  323.          (progn
  324.            (set-buffer buffer)
  325.            (reset-buffer buffer)
  326.            (setq default-directory dir)
  327.            ;(redirect-frame-focus (selected-scren) frame)
  328.            (make-local-variable 'print-escape-newlines)
  329.            (setq print-escape-newlines t)
  330.        (make-local-variable 'mode-motion-hook)
  331.        (or mode-motion-hook
  332.            (setq mode-motion-hook 'minibuf-mouse-tracker)) ;####disgusting
  333.        (make-local-variable 'mouse-track-click-hook)
  334.        (add-hook 'mouse-track-click-hook
  335.              'minibuf-maybe-select-highlighted-completion)
  336.            (set-window-buffer window buffer)
  337.            (select-window window)
  338.            (set-window-hscroll window 0)
  339.            ;; (buffer-enable-undo buffer)
  340.            (message nil)
  341.            (if initial-contents
  342.                (if (consp initial-contents)
  343.                    (progn
  344.                      (insert (car initial-contents))
  345.                      (goto-char (1+ (cdr initial-contents))))
  346.                    (insert initial-contents)))
  347.            (use-local-map (or keymap minibuffer-local-map))
  348.            (let ((mouse-grabbed-buffer (current-buffer))
  349.                  (current-prefix-arg current-prefix-arg)
  350.                  (help-form minibuffer-help-form)
  351.                  (minibuffer-history-variable (cond ((not _history_)
  352.                                                      'minibuffer-history)
  353.                                                     ((consp _history_)
  354.                                                      (car _history_))
  355.                                                     (t
  356.                                                      _history_)))
  357.                  (minibuffer-history-position (cond ((consp _history_)
  358.                                                      (cdr _history_))
  359.                                                     (t
  360.                                                      0)))
  361.                  (minibuffer-scroll-window owindow))
  362.          (if abbrev-table
  363.          (setq local-abbrev-table abbrev-table
  364.                abbrev-mode t))
  365.          ;; This is now run from read-minibuffer-internal
  366.              ;(if minibuffer-setup-hook
  367.              ;    (run-hooks 'minibuffer-setup-hook))
  368.              ;(message nil)
  369.              (if (eq 't
  370.                      (catch 'exit
  371.                        (if (> (recursion-depth) (minibuffer-depth))
  372.                            (let ((standard-output t)
  373.                                  (standard-input t))
  374.                              (read-minibuffer-internal prompt))
  375.                            (read-minibuffer-internal prompt))))
  376.                  ;; Translate an "abort" (throw 'exit 't)
  377.                  ;;  into a real quit
  378.                  (signal 'quit '())
  379.                ;; return value
  380.                (let* ((val (progn (set-buffer buffer)
  381.                                   (if minibuffer-exit-hook
  382.                                       (run-hooks 'minibuffer-exit-hook))
  383.                                   (buffer-string)))
  384.                       (err nil))
  385.                  (if readp
  386.                      (condition-case e
  387.                          (let ((v (read-from-string val)))
  388.                            (if (< (cdr v) (length val))
  389.                                (save-match-data
  390.                                  (or (string-match "[ \t\n]*\\'" val (cdr v))
  391.                                      (error "Trailing garbage following expression"))))
  392.                            (setq v (car v))
  393.                            ;; total total kludge
  394.                            (if (stringp v) (setq v (list 'quote v)))
  395.                            (setq val v))
  396.                        (error (setq err e))))
  397.                  ;; Add the value to the appropriate history list unless
  398.                  ;; it's already the most recent element, or it's only
  399.                  ;; two characters long.
  400.                  (if (and (symbolp minibuffer-history-variable)
  401.                           (boundp minibuffer-history-variable))
  402.              (let ((list (symbol-value minibuffer-history-variable)))
  403.                (or (eq list t)
  404.                (null val)
  405.                (and list (equal val (car list)))
  406.                (and (stringp val)
  407.                 minibuffer-history-minimum-string-length
  408.                 (< (length val)
  409.                    minibuffer-history-minimum-string-length))
  410.                (set minibuffer-history-variable (cons val list)))))
  411.                  (if err (signal (car err) (cdr err)))
  412.                  val))))
  413.       ;; stupid display code requires this for some reason
  414.       (set-buffer buffer)
  415.       ;;(buffer-disable-undo buffer)
  416.       (setq buffer-read-only nil)
  417.       (erase-buffer)
  418.  
  419.       ;; restore frame configurations
  420.       (if mconfig (set-window-configuration mconfig))
  421.       (set-window-configuration oconfig))))
  422.  
  423.  
  424. (defun minibuffer-max-depth-exceeded ()
  425.   ;;
  426.   ;; This signals an error if an Nth minibuffer is invoked while N-1 are
  427.   ;; already active, whether the minibuffer window is selected or not.
  428.   ;; Since, under X, it's easy to jump out of the minibuffer (by doing M-x,
  429.   ;; getting distracted, and clicking elsewhere) many many novice users have
  430.   ;; had the problem of having multiple minibuffers build up, even to the
  431.   ;; point of exceeding max-lisp-eval-depth.  Since the variable
  432.   ;; enable-recursive-minibuffers historically/crockishly is only consulted
  433.   ;; when the minibuffer is currently active (like typing M-x M-x) it doesn't
  434.   ;; help in this situation.
  435.   ;;
  436.   ;; This routine also offers to edit .emacs for you to get rid of this
  437.   ;; complaint, like `disabled' commands do, since it's likely that non-novice
  438.   ;; users will be annoyed by this change, so we give them an easy way to get
  439.   ;; rid of it forever.
  440.   ;; 
  441.   (beep t 'minibuffer-limit-exceeded)
  442.   (message
  443.    "Minibuffer already active: abort it with `^]', enable new one with `n': ")
  444.   (let ((char (let ((cursor-in-echo-area t)) ; #### doesn't always work??
  445.         (read-char))))
  446.     (cond
  447.      ((eq char ?n)
  448.       (cond
  449.        ((y-or-n-p "Enable recursive minibuffers for other sessions too? ")
  450.     ;; This is completely disgusting, but it's basically what novice.el
  451.     ;; does.  This kind of thing should be generalized.
  452.     (setq minibuffer-max-depth nil)
  453.     (save-excursion
  454.       (set-buffer
  455.        (find-file-noselect
  456.         (substitute-in-file-name "~/.emacs")))
  457.       (goto-char (point-min))
  458.       (if (re-search-forward 
  459.            "^(setq minibuffer-max-depth \\([0-9]+\\|'?nil\\|'?()\\))\n"
  460.            nil t)
  461.           (delete-region (match-beginning 0 ) (match-end 0))
  462.         ;; Must have been disabled by default.
  463.         (goto-char (point-max)))
  464.       (insert"\n(setq minibuffer-max-depth nil)\n")
  465.       (save-buffer))
  466.     (message "Multiple minibuffers enabled")
  467.     (sit-for 1))))
  468.      ((eq char ?)
  469.       (abort-recursive-edit))
  470.      (t
  471.       (error "Minibuffer already active")))))
  472.  
  473.  
  474. ;;;; Guts of minibuffer completion
  475.  
  476.  
  477. ;; Used by minibuffer-do-completion
  478. (defvar last-exact-completion)
  479.  
  480. (defun temp-minibuffer-message (m)
  481.   (let ((savemax (point-max)))
  482.     (save-excursion
  483.       (goto-char (point-max))
  484.       (message nil)
  485.       (insert m))
  486.     (let ((inhibit-quit t))
  487.       (sit-for 2)
  488.       (delete-region savemax (point-max))
  489.       ;;  If the user types a ^G while we're in sit-for, then quit-flag 
  490.       ;;  gets set. In this case, we want that ^G to be interpreted 
  491.       ;;  as a normal character, and act just like typeahead.
  492.       (if (and quit-flag (not unread-command-event))
  493.           (setq unread-command-event (character-to-event (quit-char))
  494.                 quit-flag nil)))))
  495.  
  496.  
  497. ;; Determines whether buffer-string is an exact completion
  498. (defun exact-minibuffer-completion-p (buffer-string)
  499.   (cond ((not minibuffer-completion-table)
  500.          ;; Empty alist
  501.          nil)
  502.         ((vectorp minibuffer-completion-table)
  503.          (let ((tem (intern-soft buffer-string
  504.                                  minibuffer-completion-table)))
  505.            (if (or tem
  506.                    (and (string-equal buffer-string "nil")
  507.                         ;; intern-soft loses for 'nil
  508.                         (catch 'found
  509.                           (mapatoms #'(lambda (s)
  510.                     (if (string-equal
  511.                          (symbol-name s)
  512.                          buffer-string)
  513.                         (throw 'found t)))
  514.                     minibuffer-completion-table)
  515.                           nil)))
  516.                (if minibuffer-completion-predicate
  517.                    (funcall minibuffer-completion-predicate
  518.                             tem)
  519.                    t)
  520.                nil)))
  521.         ((and (consp minibuffer-completion-table)
  522.               ;;#### Emacs-Lisp truly sucks!
  523.               ;; lambda, autoload, etc
  524.               (not (symbolp (car minibuffer-completion-table))))
  525.          (if (not completion-ignore-case)
  526.              (assoc buffer-string minibuffer-completion-table)
  527.              (let ((s (upcase buffer-string))
  528.                    (tail minibuffer-completion-table)
  529.                    tem)
  530.                (while tail
  531.                  (setq tem (car (car tail)))
  532.                  (if (or (equal tem buffer-string)
  533.                          (equal tem s)
  534.                          (equal (upcase tem) s))
  535.                      (setq s 'win
  536.                            tail nil)    ;exit
  537.                      (setq tail (cdr tail))))
  538.                (eq s 'win))))
  539.         (t
  540.          (funcall minibuffer-completion-table
  541.                   buffer-string
  542.                   minibuffer-completion-predicate
  543.                   'lambda)))
  544.   )
  545.  
  546. ;; 0 'none                 no possible completion
  547. ;; 1 'unique               was already an exact and unique completion
  548. ;; 3 'exact                was already an exact (but nonunique) completion
  549. ;; NOT USED 'completed-exact-unique completed to an exact and completion 
  550. ;; 4 'completed-exact      completed to an exact (but nonunique) completion
  551. ;; 5 'completed            some completion happened
  552. ;; 6 'uncompleted          no completion happened
  553. (defun minibuffer-do-completion-1 (buffer-string completion)
  554.   (cond ((not completion)
  555.          'none)
  556.         ((eq completion t)
  557.          ;; exact and unique match
  558.          'unique)
  559.         (t
  560.          ;; It did find a match.  Do we match some possibility exactly now?
  561.          (let ((completedp (not (string-equal completion buffer-string))))
  562.            (if completedp
  563.                (progn
  564.                  ;; Some completion happened
  565.                  (erase-buffer)
  566.                  (insert completion)
  567.                  (setq buffer-string completion)))
  568.            (if (exact-minibuffer-completion-p buffer-string)
  569.                ;; An exact completion was possible
  570.                (if completedp
  571. ;; Since no callers need to know the difference, don't bother
  572. ;;  with this (potentially expensive) discrimination.
  573. ;;                 (if (eq (try-completion completion
  574. ;;                                         minibuffer-completion-table
  575. ;;                                         minibuffer-completion-predicate)
  576. ;;                         't)
  577. ;;                     'completed-exact-unique
  578.                        'completed-exact
  579. ;;                     )
  580.                    'exact)
  581.                ;; Not an exact match
  582.                (if completedp
  583.                    'completed
  584.                    'uncompleted))))))
  585.  
  586.  
  587. (defun minibuffer-do-completion (buffer-string)
  588.   (let* ((completion (try-completion buffer-string
  589.                                      minibuffer-completion-table
  590.                                      minibuffer-completion-predicate))
  591.          (status (minibuffer-do-completion-1 buffer-string completion))
  592.          (last last-exact-completion))
  593.     (setq last-exact-completion nil)
  594.     (cond ((eq status 'none)
  595.            ;; No completions
  596.            (ding nil 'no-completion)
  597.            (temp-minibuffer-message " [No match]"))
  598.           ((eq status 'unique)
  599.            )
  600.           (t
  601.            ;; It did find a match.  Do we match some possibility exactly now?
  602.            (if (not (string-equal completion buffer-string))
  603.                (progn
  604.                  ;; Some completion happened
  605.                  (erase-buffer)
  606.                  (insert completion)
  607.                  (setq buffer-string completion)))
  608.            (cond ((eq status 'exact)
  609.                   ;; If the last exact completion and this one were
  610.                   ;;  the same, it means we've already given a
  611.                   ;;  "Complete but not unique" message and that the
  612.                   ;;  user's hit TAB again, so now we give help.
  613.                   (setq last-exact-completion completion)
  614.                   (if (equal buffer-string last)
  615.                       (minibuffer-completion-help)))
  616.                  ((eq status 'uncompleted)
  617.                   (if completion-auto-help
  618.                       (minibuffer-completion-help)
  619.                       (temp-minibuffer-message " [Next char not unique]")))
  620.                  (t
  621.                   nil))))
  622.     status))
  623.  
  624.  
  625. ;;;; completing-read
  626.  
  627. (defun completing-read (prompt table
  628.                         &optional predicate require-match
  629.                                   initial-contents history)
  630.   "Read a string in the minibuffer, with completion.
  631. Args: PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-CONTENTS, HISTORY.
  632. PROMPT is a string to prompt with; normally it ends in a colon and a space.
  633. TABLE is an alist whose elements' cars are strings, or an obarray.
  634. PREDICATE limits completion to a subset of TABLE.
  635. See `try-completion' for more details on completion, TABLE, and PREDICATE.
  636. If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
  637.  the input is (or completes to) an element of TABLE or is null.
  638.  If it is also not t, Return does not exit if it does non-null completion.
  639. If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially.
  640.   If it is (STRING . POSITION), the initial input
  641.   is STRING, but point is placed POSITION characters into the string.
  642. HISTORY, if non-nil, specifies a history list
  643.   and optionally the initial position in the list.
  644.   It can be a symbol, which is the history list variable to use,
  645.   or it can be a cons cell (HISTVAR . HISTPOS).
  646.   In that case, HISTVAR is the history list variable to use,
  647.   and HISTPOS is the initial position (the position in the list
  648.   which INITIAL-CONTENTS corresponds to).
  649.   If HISTORY is `t', no history will be recorded.
  650.   Positions are counted starting from 1 at the beginning of the list.
  651. Completion ignores case if the ambient value of
  652.   `completion-ignore-case' is non-nil."
  653.   (let ((minibuffer-completion-table table)
  654.         (minibuffer-completion-predicate predicate)
  655.         (minibuffer-completion-confirm (if (eq require-match 't) nil t))
  656.         (last-exact-completion nil))
  657.     (read-from-minibuffer prompt
  658.                           initial-contents
  659.                           (if (not require-match)
  660.                               minibuffer-local-completion-map
  661.                               minibuffer-local-must-match-map)
  662.                           nil
  663.                           history)))
  664.  
  665.  
  666. ;;;; Minibuffer completion commands
  667.  
  668.  
  669. (defun minibuffer-complete ()
  670.   "Complete the minibuffer contents as far as possible.
  671. Return nil if there is no valid completion, else t.
  672. If no characters can be completed, display a list of possible completions.
  673. If you repeat this command after it displayed such a list,
  674. scroll the window of possible completions."
  675.   (interactive)
  676.   ;; If the previous command was not this, then mark the completion
  677.   ;;  buffer obsolete.
  678.   (or (eq last-command this-command)
  679.       (setq minibuffer-scroll-window nil))
  680.   (let ((window minibuffer-scroll-window))
  681.     (if (and window (windowp window) (window-buffer window)
  682.              (buffer-name (window-buffer window)))
  683.     ;; If there's a fresh completion window with a live buffer
  684.     ;;  and this command is repeated, scroll that window.
  685.     (let ((obuf (current-buffer)))
  686.           (unwind-protect
  687.           (progn
  688.         (set-buffer (window-buffer window))
  689.         (if (pos-visible-in-window-p (point-max) window)
  690.             ;; If end is in view, scroll up to the beginning.
  691.             (set-window-start window (point-min))
  692.           ;; Else scroll down one frame.
  693.           (scroll-other-window)))
  694.         (set-buffer obuf))
  695.           nil)
  696.       (let ((status (minibuffer-do-completion (buffer-string))))
  697.     (if (eq status 'none)
  698.         nil
  699.       (progn
  700.         (cond ((eq status 'unique)
  701.            (temp-minibuffer-message
  702.             " [Sole completion]"))
  703.           ((eq status 'exact)
  704.            (temp-minibuffer-message
  705.             " [Complete, but not unique]")))
  706.         t))))))
  707.  
  708.  
  709. (defun minibuffer-complete-and-exit ()
  710.   "Complete the minibuffer contents, and maybe exit.
  711. Exit if the name is valid with no completion needed.
  712. If name was completed to a valid match,
  713. a repetition of this command will exit."
  714.   (interactive)
  715.   (if (= (point-min) (point-max))
  716.       ;; Crockishly allow user to specify null string
  717.       (throw 'exit nil))
  718.   (let ((buffer-string (buffer-string)))
  719.     ;; Short-cut -- don't call minibuffer-do-completion if we already
  720.     ;;  have an (possibly nonunique) exact completion.
  721.     (if (exact-minibuffer-completion-p buffer-string)
  722.         (throw 'exit nil))
  723.     (let ((status (minibuffer-do-completion buffer-string)))
  724.       (if (or (eq status 'unique)
  725.               (eq status 'exact)
  726.               (if (or (eq status 'completed-exact)
  727.                       (eq status 'completed-exact-unique))
  728.                   (if minibuffer-completion-confirm
  729.                       (progn (temp-minibuffer-message " [Confirm]")
  730.                              nil)
  731.                       t)))
  732.           (throw 'exit nil)))))
  733.  
  734.  
  735. (defun self-insert-and-exit ()
  736.   "Terminate minibuffer input."
  737.   (interactive)
  738.   (self-insert-command 1)
  739.   (throw 'exit nil))
  740.  
  741. (defun exit-minibuffer ()
  742.   "Terminate this minibuffer argument.
  743. If minibuffer-confirm-incomplete is true, and we are in a completing-read
  744. of some kind, and the contents of the minibuffer is not an existing
  745. completion, requires an additional RET before the minibuffer will be exited
  746. \(assuming that RET was the character that invoked this command:
  747. the character in question must be typed again)."
  748.   (interactive)
  749.   (if (not minibuffer-confirm-incomplete)
  750.       (throw 'exit nil))
  751.   (let ((buffer-string (buffer-string)))
  752.     (if (exact-minibuffer-completion-p buffer-string)
  753.         (throw 'exit nil))
  754.     (let ((completion (if (not minibuffer-completion-table)
  755.                           t
  756.                           (try-completion buffer-string
  757.                                           minibuffer-completion-table
  758.                                           minibuffer-completion-predicate))))
  759.       (if (or (eq completion 't)
  760.               ;; Crockishly allow user to specify null string
  761.               (string-equal buffer-string ""))
  762.           (throw 'exit nil))
  763.       (if completion ;; rewritten for I18N3 snarfing
  764.       (temp-minibuffer-message " [incomplete; confirm]")
  765.     (temp-minibuffer-message " [no completions; confirm]"))
  766.       (let ((event (let ((inhibit-quit t))
  767.              (prog1
  768.              (next-command-event)
  769.                (setq quit-flag nil)))))
  770.         (cond ((equal event last-command-event)
  771.                (throw 'exit nil))
  772.               ((equal (quit-char) (event-to-character event))
  773.                ;; Minibuffer abort.
  774.                (throw 'exit t)))
  775.         (dispatch-event event)))))
  776.  
  777. ;;;; minibuffer-complete-word
  778.  
  779.  
  780. ;;;#### I think I have done this correctly; it certainly is simpler
  781. ;;;#### than what the C code seemed to be trying to do.
  782. (defun minibuffer-complete-word ()
  783.   "Complete the minibuffer contents at most a single word.
  784. After one word is completed as much as possible, a space or hyphen
  785. is added, provided that matches some possible completion.
  786. Return nil if there is no valid completion, else t."
  787.   (interactive)
  788.   (let* ((buffer-string (buffer-string))
  789.          (completion (try-completion buffer-string
  790.                                      minibuffer-completion-table
  791.                                      minibuffer-completion-predicate))
  792.          (status (minibuffer-do-completion-1 buffer-string completion)))
  793.     (cond ((eq status 'none)
  794.            (ding nil 'no-completion)
  795.            (temp-minibuffer-message " [No match]")
  796.            nil)
  797.           ((eq status 'unique)
  798.            ;; New message, only in this new Lisp code
  799.            (temp-minibuffer-message " [Sole completion]")
  800.            t)
  801.           (t
  802.            (cond ((or (eq status 'uncompleted)
  803.                       (eq status 'exact))
  804.                   (let ((foo #'(lambda (s)
  805.                  (condition-case nil
  806.                      (if (try-completion
  807.                       (concat buffer-string s)
  808.                       minibuffer-completion-table
  809.                       minibuffer-completion-predicate)
  810.                      (progn
  811.                        (goto-char (point-max))
  812.                        (insert s)
  813.                        t)
  814.                                        nil)
  815.                                    (error nil))))
  816.                         (char last-command-char))
  817.                     ;; Try to complete by adding a word-delimiter
  818.                     (or (and (integerp char) (> char 0)
  819.                              (funcall foo (char-to-string char)))
  820.                         (and (not (eq char ?\ ))
  821.                              (funcall foo " "))
  822.                         (and (not (eq char ?\-))
  823.                              (funcall foo "-"))
  824.                         (progn
  825.                           (if completion-auto-help 
  826.                               (minibuffer-completion-help)
  827.                               ;; New message, only in this new Lisp code
  828.                 ;; rewritten for I18N3 snarfing
  829.                 (if (eq status 'exact)
  830.                 (temp-minibuffer-message
  831.                  " [Complete, but not unique]")
  832.                   (temp-minibuffer-message " [Ambiguous]")))
  833.                           nil))))
  834.                  (t
  835.                   (erase-buffer)
  836.                   (insert completion)
  837.                   ;; First word-break in stuff found by completion
  838.                   (goto-char (point-min))
  839.                   (let ((len (length buffer-string))
  840.                         n)
  841.                     (if (and (< len (length completion))
  842.                              (catch 'match
  843.                                (setq n 0)
  844.                                (while (< n len)
  845.                                  (if (char-equal
  846.                                        (upcase (aref buffer-string n))
  847.                                        (upcase (aref completion n)))
  848.                                      (setq n (1+ n))
  849.                                      (throw 'match nil)))
  850.                                t)
  851.                              (progn
  852.                                (goto-char (point-min))
  853.                                (forward-char len)
  854.                                (re-search-forward "\\W" nil t)))
  855.                         (delete-region (point) (point-max))
  856.                         (goto-char (point-max))))
  857.                   t))))))
  858.  
  859. ;;;; Completion help
  860.  
  861. (defvar completion-highlight-first-word-only nil
  862.   "*Completion will only hightlight the first blank delimited word if t.
  863. If the variable in not t or nil, the string is taken as a regexp to match for end
  864. of highlight")
  865.  
  866. (defconst display-completion-list-keymap (make-sparse-keymap))
  867. (define-key display-completion-list-keymap 'button2
  868.   'display-completion-list-clicked-on)
  869.  
  870. (defun completion-insert-at-point (extent buffer)
  871.   (or (bufferp buffer) (setq buffer (current-buffer)))
  872.   (save-current-buffer
  873.    (set-buffer buffer)
  874.    (insert (extent-string extent))))
  875.  
  876. (defun display-completion-list-clicked-on (event)
  877.   (interactive "e")
  878.   (let* ((extent (extent-at (event-closest-point event)
  879.                 (event-buffer event)
  880.                 'completion))
  881.      (func (extent-property extent 'completion-activate-callback))
  882.      (user-data (extent-property extent 'completion-user-data)))
  883.     (if func
  884.     (funcall func extent user-data))))
  885.  
  886. (defun display-completion-list (completions &optional
  887.                         activate-callback user-data)
  888.   "Display the list of completions, COMPLETIONS, using `standard-output'.
  889. Each element may be just a symbol or string or may be a list of two
  890.  strings to be printed as if concatenated.
  891. Frob a mousable extent onto each completion.  This extent has properties
  892.  'highlight (so it highlights when the mouse passes over it) and
  893.  'completion (so it can be located).  If ACTIVATE-CALLBACK is non-nil,
  894.  it should be a function of two arguments (EXTENT USER-DATA) that will
  895.  be called when button2 is pressed on the extent. (This is set up
  896.  using an extent-local keymap; therefore, button2 will have its normal
  897.  binding if clicked outside of the extent.)
  898. At the end, run the normal hook `completion-setup-hook'.
  899. It can find the completion buffer in `standard-output'.
  900. If `completion-highlight-first-word-only' is non-nil, then only the start
  901.  of the string is highlighted."
  902.    ;; #### I18N3 should set standard-output to be (temporarily)
  903.    ;; output-translating.
  904.   (let ((old-buffer (current-buffer))
  905.         (bufferp (bufferp standard-output)))
  906.     (if bufferp
  907.         (set-buffer standard-output))
  908.     (if (null completions)
  909.         (princ (gettext
  910.         "There are no possible completions of what you have typed."))
  911.       (let ((win-width (if bufferp
  912.                            ;; This needs fixing for the case of windows 
  913.                            ;; that aren't the same width's the frame.
  914.                            ;; Sadly, the window it will appear in is not known
  915.                            ;; until after the text has been made.
  916.                            (frame-width (selected-frame))
  917.                            80)))
  918.         (let ((count 0)
  919.               (max-width 0))
  920.           ;; Find longest completion
  921.           (let ((tail completions))
  922.             (while tail
  923.               (let* ((elt (car tail))
  924.                      (len (cond ((stringp elt)
  925.                                  (length elt))
  926.                                 ((and (consp elt)
  927.                                       (stringp (car elt))
  928.                                       (stringp (car (cdr elt))))
  929.                                  (+ (length (car elt))
  930.                                     (length (car (cdr elt)))))
  931.                                 (t
  932.                                  (signal 'wrong-type-argument
  933.                                          (list 'stringp elt))))))
  934.                 (if (> len max-width)
  935.                     (setq max-width len))
  936.                 (setq count (1+ count)
  937.                       tail (cdr tail)))))
  938.         
  939.           (setq max-width (+ 2 max-width)) ; at least two chars between cols
  940.           (let ((rows (let ((cols (min (/ win-width max-width) count)))
  941.                         (if (<= cols 1)
  942.                             count
  943.                           (progn
  944.                             ;; re-space the columns
  945.                             (setq max-width (/ win-width cols))
  946.                             (if (/= (% count cols) 0) ; want ceiling...
  947.                                 (1+ (/ count cols))
  948.                                 (/ count cols)))))))
  949.             (princ (gettext "Possible completions are:"))
  950.             (let ((tail completions)
  951.                   (r 0)
  952.           (regexp-string (if (eq t
  953.                      completion-highlight-first-word-only)
  954.                      "[ \t]"
  955.                    completion-highlight-first-word-only)))
  956.               (while (< r rows)
  957.                 (terpri)
  958.                 (let ((indent 0)
  959.                       (column 0)
  960.                       (tail2 tail))
  961.                   (while tail2
  962.                     (let ((elt (car tail2)))
  963.                       (if (/= indent 0)
  964.                           (if bufferp
  965.                               (indent-to indent 2)
  966.                               (while (progn (write-char ?\ )
  967.                                             (setq column (1+ column))
  968.                                             (< column indent)))))
  969.                       (setq indent (+ indent max-width))
  970.               (let ((start (point))
  971.                 end)
  972.             ;; Frob some mousable extents in there too!
  973.             (if (consp elt)
  974.                 (progn
  975.                   (princ (car elt))
  976.                   (princ (car (cdr elt)))
  977.                   (or bufferp
  978.                   (setq column (+ column
  979.                           (length (car elt))
  980.                           (length (car (cdr elt)))))))
  981.                           (progn
  982.                             (princ elt)
  983.                             (or bufferp
  984.                                 (setq column (+ column (length
  985.                             elt))))))
  986.             (let
  987.                 ((extent
  988.                   (make-extent
  989.                    start
  990.                    (progn
  991.                  (setq end (point))
  992.                  (or
  993.                   (and completion-highlight-first-word-only
  994.                        (goto-char start)
  995.                        (re-search-forward regexp-string end t)
  996.                        (match-beginning 0))
  997.                   end)))))
  998.               (goto-char end)
  999.               (set-extent-property extent 'highlight t)
  1000.               (set-extent-property extent 'completion t)
  1001.               (if activate-callback
  1002.                   (progn
  1003.                     (set-extent-property extent
  1004.                            'completion-activate-callback
  1005.                            activate-callback)
  1006.                     (set-extent-property extent
  1007.                            'completion-user-data
  1008.                            user-data)
  1009.                     (set-extent-property extent 'keymap
  1010.                            display-completion-list-keymap)))
  1011.               )))
  1012.                     (setq tail2 (nthcdr rows tail2)))
  1013.                   (setq tail (cdr tail)
  1014.                         r (1+ r)))))))))
  1015.     (if bufferp
  1016.         (set-buffer old-buffer)))
  1017.   (run-hooks 'completion-setup-hook))
  1018.  
  1019. (defun minibuffer-completion-help ()
  1020.   "Display a list of possible completions of the current minibuffer contents."
  1021.   (interactive)
  1022.   (message "Making completion list...")
  1023.   (let ((completions (all-completions (buffer-string)
  1024.                                       minibuffer-completion-table
  1025.                                       minibuffer-completion-predicate)))
  1026.     (message nil)
  1027.     (if (null completions)
  1028.         (progn
  1029.           (ding nil 'no-completion)
  1030.           (temp-minibuffer-message " [No completions]"))
  1031.         (with-output-to-temp-buffer "*Completions*"
  1032.           (display-completion-list (sort completions #'string-lessp))))))
  1033.  
  1034. ;;;; Minibuffer History
  1035.  
  1036. (defvar minibuffer-history '()
  1037.   "Default minibuffer history list.
  1038. This is used for all minibuffer input except when an alternate history
  1039. list is specified.")
  1040.  
  1041. ;; Some other history lists:
  1042. ;;
  1043. (defvar minibuffer-history-search-history '())
  1044. (defvar function-history '())
  1045. (defvar variable-history '())
  1046. (defvar buffer-history '())
  1047. (defvar shell-command-history '())
  1048. (defvar file-name-history '())
  1049.  
  1050. (defvar read-expression-history nil)
  1051.  
  1052. (defvar minibuffer-history-sexp-flag nil ;weird FSF Emacs kludge
  1053.   "Non-nil when doing history operations on `command-history'.
  1054. More generally, indicates that the history list being acted on
  1055. contains expressions rather than strings.")
  1056.  
  1057. (defun previous-matching-history-element (regexp n)
  1058.   "Find the previous history element that matches REGEXP.
  1059. \(Previous history elements refer to earlier actions.)
  1060. With prefix argument N, search for Nth previous match.
  1061. If N is negative, find the next or Nth next match."
  1062.   (interactive
  1063.    (let ((enable-recursive-minibuffers t)
  1064.      (minibuffer-history-sexp-flag nil))
  1065.      (if (eq 't (symbol-value minibuffer-history-variable))
  1066.      (error "history is not being recorded in this context"))
  1067.      (list (read-from-minibuffer "Previous element matching (regexp): "
  1068.                  (car minibuffer-history-search-history)
  1069.                  minibuffer-local-map
  1070.                  nil
  1071.                  'minibuffer-history-search-history)
  1072.        (prefix-numeric-value current-prefix-arg))))
  1073.   (let ((history (symbol-value minibuffer-history-variable))
  1074.     prevpos
  1075.     (pos minibuffer-history-position))
  1076.     (if (eq history t)
  1077.     (error "history is not being recorded in this context"))
  1078.     (while (/= n 0)
  1079.       (setq prevpos pos)
  1080.       (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
  1081.       (if (= pos prevpos)
  1082.       (if (= pos 1) ;; rewritten for I18N3 snarfing
  1083.           (error "No later matching history item")
  1084.         (error "No earlier matching history item")))
  1085.       (if (string-match regexp
  1086.             (if minibuffer-history-sexp-flag
  1087.                 (prin1-to-string (nth (1- pos) history))
  1088.                             (nth (1- pos) history)))
  1089.       (setq n (+ n (if (< n 0) 1 -1)))))
  1090.     (setq minibuffer-history-position pos)
  1091.     (erase-buffer)
  1092.     (let ((elt (nth (1- pos) history)))
  1093.       (insert (if minibuffer-history-sexp-flag
  1094.           (prin1-to-string elt)
  1095.                   elt)))
  1096.       (goto-char (point-min)))
  1097.   (if (or (eq (car (car command-history)) 'previous-matching-history-element)
  1098.       (eq (car (car command-history)) 'next-matching-history-element))
  1099.       (setq command-history (cdr command-history))))
  1100.  
  1101. (defun next-matching-history-element (regexp n)
  1102.   "Find the next history element that matches REGEXP.
  1103. \(The next history element refers to a more recent action.)
  1104. With prefix argument N, search for Nth next match.
  1105. If N is negative, find the previous or Nth previous match."
  1106.   (interactive
  1107.    (let ((enable-recursive-minibuffers t)
  1108.      (minibuffer-history-sexp-flag nil))
  1109.      (if (eq t (symbol-value minibuffer-history-variable))
  1110.      (error "history is not being recorded in this context"))
  1111.      (list (read-from-minibuffer "Next element matching (regexp): "
  1112.                  (car minibuffer-history-search-history)
  1113.                  minibuffer-local-map
  1114.                  nil
  1115.                  'minibuffer-history-search-history)
  1116.        (prefix-numeric-value current-prefix-arg))))
  1117.   (previous-matching-history-element regexp (- n)))
  1118.  
  1119. (defun next-history-element (n)
  1120.   "Insert the next element of the minibuffer history into the minibuffer."
  1121.   (interactive "p")
  1122.   (if (eq 't (symbol-value minibuffer-history-variable))
  1123.       (error "history is not being recorded in this context"))
  1124.   (let ((narg (min (max 1 (- minibuffer-history-position n))
  1125.            (length (symbol-value minibuffer-history-variable)))))
  1126.     (if (= minibuffer-history-position narg)
  1127.     (error (if (>= n 0) ;; rewritten for I18N3 snarfing
  1128.            (format "No following item in %s"
  1129.                minibuffer-history-variable)
  1130.          (format "No preceding item in %s"
  1131.              minibuffer-history-variable)))
  1132.       (erase-buffer)
  1133.       (setq minibuffer-history-position narg)
  1134.       (let ((elt (nth (1- minibuffer-history-position)
  1135.               (symbol-value minibuffer-history-variable))))
  1136.     (insert
  1137.      (if (and minibuffer-history-sexp-flag
  1138.           ;; total kludge
  1139.           (not (stringp elt)))
  1140.          (condition-case nil
  1141.          (let ((print-readably t) (print-escape-newlines t))
  1142.                    (prin1-to-string elt))
  1143.            (error (prin1-to-string elt)))
  1144.              elt)))
  1145.       (goto-char (point-max)))))
  1146.  
  1147. (defun previous-history-element (n)
  1148.   "Inserts the previous element of the minibuffer history into the minibuffer."
  1149.   (interactive "p")
  1150.   (next-history-element (- n)))
  1151.  
  1152. (defun next-complete-history-element (n)
  1153.   "Get next element of history which is a completion of minibuffer contents."
  1154.   (interactive "p")
  1155.   (let ((point-at-start (point)))
  1156.     (next-matching-history-element
  1157.      (concat "^" (regexp-quote (buffer-substring (point-min) (point)))) n)
  1158.     ;; next-matching-history-element always puts us at (point-min).
  1159.     ;; Move to the position we were at before changing the buffer contents.
  1160.     ;; This is still sensical, because the text before point has not changed.
  1161.     (goto-char point-at-start)))
  1162.  
  1163. (defun previous-complete-history-element (n)
  1164.   "Get previous element of history which is a completion of minibuffer contents."
  1165.   (interactive "p")
  1166.   (next-complete-history-element (- n)))
  1167.  
  1168. ;;;; reading various things from a minibuffer
  1169.  
  1170. (defun read-expression (prompt &optional initial-contents history)
  1171.   "Return a Lisp object read using the minibuffer.
  1172. Prompt with PROMPT.  If non-nil, optional second arg INITIAL-CONTENTS
  1173. is a string to insert in the minibuffer before reading.
  1174. Third arg HISTORY, if non-nil, specifies a history list."
  1175.   (let ((minibuffer-history-sexp-flag t)
  1176.     ;; Semi-kludge to get around M-x C-x o M-ESC trying to do completion.
  1177.     (minibuffer-completion-table nil))
  1178.     (read-from-minibuffer prompt
  1179.               initial-contents
  1180.               read-expression-map
  1181.               t
  1182.               (or history 'read-expression-history)
  1183.               lisp-mode-abbrev-table)))
  1184.  
  1185. (defun read-string (prompt &optional initial-contents history)
  1186.   "Return a string from the minibuffer, prompting with string PROMPT.
  1187. If non-nil, optional second arg INITIAL-CONTENTS is a string to insert
  1188. in the minibuffer before reading.
  1189. Third arg HISTORY, if non-nil, specifies a history list."
  1190.   (let ((minibuffer-completion-table nil))
  1191.     (read-from-minibuffer prompt
  1192.               initial-contents
  1193.               minibuffer-local-map
  1194.               nil history)))
  1195.  
  1196. (defun eval-minibuffer (prompt &optional initial-contents history)
  1197.   "Return value of Lisp expression read using the minibuffer.
  1198. Prompt with PROMPT.  If non-nil, optional second arg INITIAL-CONTENTS
  1199. is a string to insert in the minibuffer before reading.
  1200. Third arg HISTORY, if non-nil, specifies a history list."
  1201.   (eval (read-expression prompt initial-contents history)))
  1202.  
  1203. ;;;#### Screw this crock!!
  1204. ;(defun read-no-blanks-input (prompt &optional initial-contents)
  1205. ; "Read a string from the terminal, not allowing blanks.
  1206. ;Prompt with PROMPT.  If non-nil, optional second arg INITIAL-CONTENTS
  1207. ;is a string to insert in the minibuffer before reading."
  1208. ;  (let ((minibuffer-completion-table nil))
  1209. ; (read-from-minibuffer prompt
  1210. ;                       initial-contents
  1211. ;                       minibuffer-local-ns-map
  1212. ;                       nil)))
  1213.  
  1214. ;; The name `command-history' is already taken
  1215. (defvar read-command-history '())
  1216.  
  1217. (defun read-command (prompt)
  1218.   "Read the name of a command and return as a symbol.
  1219. Prompts with PROMPT."
  1220.   (intern (completing-read prompt obarray 'commandp t nil
  1221.                ;; 'command-history is not right here: that's a
  1222.                ;; list of evalable forms, not a history list.
  1223.                'read-command-history
  1224.                )))
  1225.  
  1226. (defun read-function (prompt)
  1227.   "Read the name of a function and return as a symbol.
  1228. Prompts with PROMPT."
  1229.   (intern (completing-read prompt obarray 'fboundp t nil
  1230.                'function-history)))
  1231.  
  1232. (defun read-variable (prompt)
  1233.   "Read the name of a user variable and return it as a symbol.
  1234. Prompts with PROMPT.
  1235. A user variable is one whose documentation starts with a `*' character."
  1236.   (intern (completing-read prompt obarray 'user-variable-p t nil
  1237.                'variable-history)))
  1238.  
  1239. (defun read-buffer (prompt &optional default require-match)
  1240.   "Read the name of a buffer and return as a string.
  1241. Prompts with PROMPT.  Optional second arg DEFAULT is value to return if user
  1242. enters an empty line.  If optional third arg REQUIRE-MATCH is non-nil,
  1243. only existing buffer names are allowed."
  1244.   (let ((prompt (if default 
  1245.                     (format "%s(default %s) "
  1246.                             (gettext prompt) (if (bufferp default)
  1247.                          (buffer-name default)
  1248.                            default))
  1249.                     prompt))
  1250.         (alist (mapcar #'(lambda (b) (cons (buffer-name b) b))
  1251.                        (buffer-list)))
  1252.         result)
  1253.     (while (progn
  1254.              (setq result (completing-read prompt alist nil require-match
  1255.                        nil 'buffer-history))
  1256.              (cond ((not (equal result ""))
  1257.                     nil)
  1258.                    ((not require-match)
  1259.                     (setq result default)
  1260.                     nil)
  1261.                    ((not default)
  1262.                     t)
  1263.                    ((not (get-buffer default))
  1264.                     t)
  1265.                    (t
  1266.                     (setq result default)
  1267.                     nil))))
  1268.     (if (bufferp result)
  1269.         (buffer-name result)
  1270.       result)))
  1271.  
  1272. (defun read-number (prompt &optional integers-only)
  1273.   "Reads a number from the minibuffer."
  1274.   (let ((pred (if integers-only 'integerp 'numberp))
  1275.     num)
  1276.     (while (not (funcall pred num))
  1277.       (setq num (condition-case ()
  1278.             (let ((minibuffer-completion-table nil))
  1279.               (read-from-minibuffer
  1280.                prompt (if num (prin1-to-string num)) nil t
  1281.                t)) ;no history
  1282.           (invalid-read-syntax nil)
  1283.           (end-of-file nil)))
  1284.       (or (funcall pred num) (beep)))
  1285.     num))
  1286.  
  1287. (defun read-shell-command (prompt &optional initial-input history)
  1288.   "Just like read-string, but uses read-shell-command-map:
  1289. \\{read-shell-command-map}"
  1290.   (let ((minibuffer-completion-table nil))
  1291.     (read-from-minibuffer prompt initial-input read-shell-command-map
  1292.               nil (or history 'shell-command-history))))
  1293.  
  1294.  
  1295. ;;; This read-file-name stuff probably belongs in files.el
  1296.  
  1297. ;; Quote "$" as "$$" to get it past substitute-in-file-name
  1298. (defun un-substitute-in-file-name (string)
  1299.   (let ((regexp "\\$")
  1300.         (olen (length string))
  1301.         new
  1302.         n o ch)
  1303.     (cond ((eq system-type 'vax-vms)
  1304.            string)
  1305.           ((not (string-match regexp string))
  1306.            string)
  1307.           (t
  1308.            (setq n 1)
  1309.            (while (string-match regexp string (match-end 0))
  1310.              (setq n (1+ n)))
  1311.            (setq new (make-string (+ olen n) ?$))
  1312.            (setq n 0 o 0)
  1313.            (while (< o olen)
  1314.              (setq ch (aref string o))
  1315.              (aset new n ch)
  1316.              (setq o (1+ o) n (1+ n))
  1317.              (if (eq ch ?$)
  1318.                  ;; already aset by make-string initial-value
  1319.                  (setq n (1+ n))))
  1320.            new))))
  1321.   
  1322. (defun read-file-name-1 (history prompt dir default 
  1323.                  must-match initial-contents
  1324.                  completer)
  1325.   (if (not dir)
  1326.       (setq dir default-directory))
  1327.   (setq dir (abbreviate-file-name dir t))
  1328.   (let* ((insert (cond ((and (not insert-default-directory)
  1329.                  (not initial-contents))
  1330.                         "")
  1331.                        (initial-contents
  1332.                         (cons (un-substitute-in-file-name
  1333.                    (concat dir initial-contents))
  1334.                               (length dir)))
  1335.                        (t
  1336.                         (un-substitute-in-file-name dir))))
  1337.          (val (let ((completion-ignore-case (eq system-type 'vax-vms)))
  1338.                 ;;  Hateful, broken, case-sensitive un*x
  1339. ;;;                 (completing-read prompt
  1340. ;;;                                  completer
  1341. ;;;                                  dir
  1342. ;;;                                  must-match
  1343. ;;;                                  insert
  1344. ;;;                                  history)
  1345.         ;; #### - this is essentially the guts of completing read.
  1346.         ;; There should be an elegant way to pass a pair of keymaps to
  1347.         ;; completing read, but this will do for now.  All sins are
  1348.         ;; relative.  --Stig
  1349.         (let ((minibuffer-completion-table completer)
  1350.               (minibuffer-completion-predicate dir)
  1351.               (minibuffer-completion-confirm (if (eq must-match 't) nil t))
  1352.               (last-exact-completion nil))
  1353.           (read-from-minibuffer prompt
  1354.                     insert
  1355.                     (if (not must-match)
  1356.                         read-file-name-map
  1357.                       read-file-name-must-match-map)
  1358.                     nil
  1359.                     history)))
  1360.           ))
  1361. ;;;     ;; Kludge!  Put "/foo/bar" on history rather than "/default//foo/bar"
  1362. ;;;     (let ((hist (cond ((not history) 'minibuffer-history)
  1363. ;;;                       ((consp history) (car history))
  1364. ;;;                       (t history))))
  1365. ;;;       (if (and val
  1366. ;;;                hist
  1367. ;;;                (not (eq hist 't))
  1368. ;;;                (boundp hist)
  1369. ;;;                (equal (car-safe (symbol-value hist)) val))
  1370. ;;;           (let ((e (condition-case nil
  1371. ;;;                        (expand-file-name val)
  1372. ;;;                      (error nil))))
  1373. ;;;             (if (and e (not (equal e val)))
  1374. ;;;                 (set hist (cons e (cdr (symbol-value hist))))))))
  1375.  
  1376.     (cond ((not val)
  1377.            (error "No file name specified"))
  1378.           ((and default
  1379.                 (equal val (if (consp insert) (car insert) insert)))
  1380.            default)
  1381.           (t
  1382.            (substitute-in-file-name val)))))
  1383.  
  1384.  
  1385. (defun read-file-name (prompt
  1386.                        &optional dir default must-match initial-contents
  1387.                history)
  1388.   "Read file name, prompting with PROMPT and completing in directory DIR.
  1389. Value is not expanded---you must call `expand-file-name' yourself.
  1390. Value is subject to interpreted by substitute-in-file-name however.
  1391. Default name to DEFAULT if user enters a null string.
  1392.  (If DEFAULT is omitted, the visited file name is used.)
  1393. Fourth arg MUST-MATCH non-nil means require existing file's name.
  1394.  Non-nil and non-t means also require confirmation after completion.
  1395. Fifth arg INITIAL-CONTENTS specifies text to start with.
  1396. Sixth arg HISTORY specifies the history list to use.  Default is
  1397.  `file-name-history'.
  1398. DIR defaults to current buffer's directory default."
  1399.   (read-file-name-1
  1400.    (or history 'file-name-history)
  1401.    prompt dir (or default buffer-file-name) must-match initial-contents
  1402.    ;; A separate function (not an anonymous lambda-expression)
  1403.    ;; and passed as a symbol because of disgusting kludges in various
  1404.    ;; places which do stuff like (let ((filename-kludge-p (eq minibuffer-completion-table 'read-file-name-internal))) ...)
  1405.    'read-file-name-internal))
  1406.  
  1407. (defun read-directory-name (prompt
  1408.                             &optional dir default must-match initial-contents)
  1409.   "Read directory name, prompting with PROMPT and completing in directory DIR.
  1410. Value is not expanded---you must call `expand-file-name' yourself.
  1411. Value is subject to interpreted by substitute-in-file-name however.
  1412. Default name to DEFAULT if user enters a null string.
  1413.  (If DEFAULT is omitted, the current buffer's default directory is used.)
  1414. Fourth arg MUST-MATCH non-nil means require existing directory's name.
  1415.  Non-nil and non-t means also require confirmation after completion.
  1416. Fifth arg INITIAL-CONTENTS specifies text to start with.
  1417. Sixth arg HISTORY specifies the history list to use.  Default is
  1418.  `file-name-history'.
  1419. DIR defaults to current buffer's directory default."
  1420.   (read-file-name-1 
  1421.     'file-name-history
  1422.     prompt dir (or default default-directory) must-match initial-contents
  1423.     'read-directory-name-internal))
  1424.  
  1425.  
  1426. ;; Environment-variable completion hack
  1427. (defun read-file-name-internal-1 (string dir action completer)
  1428.   (if (not (string-match "\\([^$]\\|\\`\\)\\(\\$\\$\\)*\\$\\([A-Za-z0-9_]*\\|{[^}]*\\)\\'"
  1429.                          string))
  1430.       ;; Not doing environment-variable completion hack
  1431.       (let* ((orig (if (equal string "") nil string))
  1432.              (sstring (if orig (substitute-in-file-name string) string))
  1433.              (specdir (if orig (file-name-directory sstring) nil)))
  1434.         (funcall completer 
  1435.                  action 
  1436.                  orig 
  1437.                  sstring 
  1438.                  specdir
  1439.                  (if specdir (expand-file-name specdir dir) dir)
  1440.                  (if orig (file-name-nondirectory sstring) string)))
  1441.       ;; An odd number of trailing $'s
  1442.       (let* ((start (match-beginning 3))
  1443.              (env (substring string 
  1444.                              (cond ((= start (length string))
  1445.                                     ;; "...$"
  1446.                                     start)
  1447.                                    ((= (aref string start) ?{)
  1448.                                     ;; "...${..."
  1449.                                     (1+ start))
  1450.                                    (t
  1451.                                     start))))
  1452.              (head (substring string 0 (1- start)))
  1453.              (alist #'(lambda ()
  1454.                         (mapcar #'(lambda (x)
  1455.                                     (cons (substring x 0 (string-match "=" x))
  1456.                                           'nil))
  1457.                                 process-environment))))
  1458.         
  1459.     (cond ((eq action 'lambda)
  1460.                nil)
  1461.               ((eq action 't)
  1462.                ;; all completions
  1463.                (mapcar #'(lambda (p)
  1464.                (if (and (> (length p) 0)
  1465.                     ;;#### Unix-specific
  1466.                     ;;####  -- need absolute-pathname-p
  1467.                     (/= (aref p 0) ?/))
  1468.                    (concat "$" p)
  1469.                              (concat head "$" p)))
  1470.                        (all-completions env (funcall alist))))
  1471.               (t ;; 'nil
  1472.                ;; complete
  1473.                (let* ((e (funcall alist))
  1474.                       (val (try-completion env e)))
  1475.                  (cond ((stringp val)
  1476.                         (if (string-match "[^A-Za-z0-9_]" val)
  1477.                             (concat head
  1478.                                     "${" val
  1479.                                     ;; completed uniquely?
  1480.                                     (if (eq (try-completion val e) 't)
  1481.                                         "}" ""))
  1482.                             (concat head "$" val)))
  1483.                        ((eql val 't)
  1484.                         (concat head
  1485.                                 (un-substitute-in-file-name (getenv env))))
  1486.                        (t nil))))))))
  1487.  
  1488.  
  1489. (defun read-file-name-internal (string dir action)
  1490.   (read-file-name-internal-1 
  1491.    string dir action
  1492.    #'(lambda (action orig string specdir dir name)
  1493.       (cond ((eq action 'lambda)
  1494.              (if (not orig)
  1495.                  nil
  1496.                (let ((sstring (condition-case nil 
  1497.                                   (expand-file-name string)
  1498.                                 (error nil))))
  1499.                  (if (not sstring)
  1500.                      ;; Some pathname syntax error in string
  1501.                      nil
  1502.                      (file-exists-p sstring)))))
  1503.             ((eq action 't)
  1504.              ;; all completions
  1505.              (mapcar #'un-substitute-in-file-name
  1506.                      (file-name-all-completions name dir)))
  1507.             (t;; 'nil
  1508.              ;; complete
  1509.              (let* ((d (or dir default-directory))
  1510.             (val (file-name-completion name d)))
  1511.                (if (and (eq val 't)
  1512.                         (not (null completion-ignored-extensions)))
  1513.                    ;;#### (file-name-completion "foo") returns 't
  1514.                    ;;   when both "foo" and "foo~" exist and the latter
  1515.                    ;;   is "pruned" by completion-ignored-extensions.
  1516.                    ;; I think this is a bug in file-name-completion.
  1517.                    (setq val (let ((completion-ignored-extensions '()))
  1518.                                (file-name-completion name d))))
  1519.                (if (stringp val)
  1520.                    (un-substitute-in-file-name (if specdir
  1521.                                                    (concat specdir val)
  1522.                                                    val))
  1523.                    (let ((tem (un-substitute-in-file-name string)))
  1524.                      (if (not (equal tem orig))
  1525.                          ;; substitute-in-file-name did something
  1526.                          tem
  1527.                          val)))))))))
  1528.  
  1529.  
  1530. (defun read-directory-name-internal (string dir action)
  1531.   (read-file-name-internal-1 
  1532.    string dir action
  1533.    #'(lambda (action orig string specdir dir name)
  1534.       (let* (;; This looks better in a possibilities list than ""
  1535.              ;;#### Un*x-specific
  1536.              (standin "./")
  1537.              (dirs #'(lambda (fn)
  1538.               (let ((l (if (equal name "")
  1539.                   (cons standin (directory-files
  1540.                                                  dir
  1541.                                                  nil
  1542.                                                  ""
  1543.                                                  nil
  1544.                                                  'directories))
  1545.                                   (directory-files
  1546.                                    dir
  1547.                                    nil 
  1548.                                    (concat "\\`" (regexp-quote name))
  1549.                                    nil
  1550.                                    'directories))))
  1551.                        (mapcar fn
  1552.                                (cond ((eq system-type 'vax-vms)
  1553.                                       l)
  1554.                                      (t
  1555.                                       ;; Wretched unix
  1556.                                       (delete "." (delete ".." l)))))))))
  1557.         (cond ((eq action 'lambda)
  1558.                ;; complete?
  1559.                (if (not orig)
  1560.                    nil
  1561.                    (and (file-directory-p string)
  1562.                         ;; So "foo" is ambiguous between "foo/" and "foobar/"
  1563.                         (equal string (file-name-as-directory string)))))
  1564.               ((eq action 't)
  1565.                ;; all completions
  1566.                (funcall dirs #'(lambda (n)
  1567.                  (un-substitute-in-file-name 
  1568.                   (if (equal n standin) 
  1569.                       standin
  1570.                                     (file-name-as-directory n))))))
  1571.               (t
  1572.                ;; complete
  1573.                (let ((val (try-completion
  1574.                            name
  1575.                            (funcall dirs
  1576.                                     #'(lambda (n)
  1577.                     (if (equal n standin)
  1578.                         (list standin)
  1579.                                           (list (file-name-as-directory
  1580.                                                  n))))))))
  1581.                  (if (stringp val)
  1582.                      (un-substitute-in-file-name (if specdir
  1583.                                                      (concat specdir val)
  1584.                                                      val))
  1585.                      (let ((tem (un-substitute-in-file-name string)))
  1586.                        (if (not (equal tem orig))
  1587.                            ;; substitute-in-file-name did something
  1588.                            tem
  1589.                            val))))))))))
  1590.  
  1591. (defun append-expand-filename (file-string string)
  1592.   "Append STRING to FILE-STRING differently depending on whether STRING
  1593. is a username (~string), an environment variable ($string), 
  1594. or a filename (/string).  The resultant string is returned with the 
  1595. environment variable or username expanded and resolved to indicate 
  1596. whether it is a file(/result) or a directory (/result/)."
  1597.   (let ((file 
  1598.      (cond ((string-match "\\([~$]\\)\\([^~$/]*\\)$" file-string)
  1599.         (cond ((string= (substring file-string 
  1600.                        (match-beginning 1)
  1601.                        (match-end 1)) "~")
  1602.                (concat (substring file-string 0 (match-end 1))
  1603.                    string))
  1604.               (t (substitute-in-file-name
  1605.               (concat (substring file-string 0 (match-end 1))
  1606.                   string)))))
  1607.            (t (concat (file-name-directory 
  1608.                (substitute-in-file-name file-string)) string))))
  1609.     result)
  1610.     
  1611.     (cond ((stringp (setq result (and (file-exists-p (expand-file-name file))
  1612.                       (read-file-name-internal 
  1613.                        (condition-case nil
  1614.                        (expand-file-name file)
  1615.                      (error file))
  1616.                        "" nil))))
  1617.        result)
  1618.       (t file))))
  1619.  
  1620. (defun read-face (prompt &optional must-match)
  1621.   "Read the name of a face from the minibuffer and return it as a symbol."
  1622.   (intern (completing-read prompt obarray 'find-face must-match)))
  1623.  
  1624. ;; #### - wrong place for this variable and function?  At some point, we'll
  1625. ;; have ansi color on ttys and so this ought to be here, but the x-specific
  1626. ;; completion stuff should probably move.
  1627.  
  1628. ;; Ben wanted all of the possibilities from the `configure' script used
  1629. ;; here, but I think this is way too many.  I already trimmed the R4 variants
  1630. ;; and a few obvious losers from the list.  --Stig  
  1631. (defvar x-library-search-path '("/usr/X11R6/lib/X11/"
  1632.                 "/usr/X11R5/lib/X11/"
  1633.                 "/usr/lib/X11R6/X11/"
  1634.                 "/usr/lib/X11R5/X11/"
  1635.                 "/usr/local/X11R6/lib/X11/"
  1636.                 "/usr/local/X11R5/lib/X11/"
  1637.                 "/usr/local/lib/X11R6/X11/"
  1638.                 "/usr/local/lib/X11R5/X11/"
  1639.                 "/usr/X11/lib/X11/"
  1640.                 "/usr/lib/X11/"
  1641.                 "/usr/local/lib/X11/"
  1642.                 "/usr/X386/lib/X11/"
  1643.                 "/usr/x386/lib/X11/"
  1644.                 "/usr/XFree86/lib/X11/"
  1645.                 "/usr/unsupported/lib/X11/"
  1646.                 "/usr/athena/lib/X11/"
  1647.                 "/usr/local/x11r5/lib/X11/"
  1648.                 "/usr/lpp/Xamples/lib/X11/"
  1649.                 "/usr/openwin/lib/X11/"
  1650.                 "/usr/openwin/share/lib/X11/")
  1651.   "Search path used by `read-color' to find rgb.txt.") 
  1652.  
  1653. (defvar read-color-completion-table)
  1654.  
  1655. (defun read-color (prompt &optional must-match)
  1656.   "Read the name of a color from the minibuffer.
  1657. Uses `x-library-search-path' to find rgb.txt in order to build a completion
  1658. table."
  1659.   (or (boundp 'read-color-completion-table)
  1660.       (let ((rgb-file (locate-file "rgb.txt" x-library-search-path))
  1661.         clist color p)
  1662.     (if (not rgb-file)
  1663.         ;; prevents multiple searches for rgb.txt if we can't find it
  1664.         (setq read-color-completion-table nil)
  1665.       (save-excursion
  1666.         (set-buffer (get-buffer-create " *colors*"))
  1667.         (erase-buffer)
  1668.         (insert-file-contents rgb-file)
  1669.         (while (not (eobp))
  1670.           (skip-chars-forward "0-9 \t")
  1671.           (setq p (point))
  1672.           (end-of-line)
  1673.           (setq color (buffer-substring p (point))
  1674.             clist (cons (list color) clist))
  1675.           ;; Ugh.  If we want to be able to complete the lowercase form
  1676.           ;; of the color name, we need to add it twice!  Yuck.
  1677.               (let ((dcase (downcase color)))
  1678.                 (or (string= dcase color)
  1679.                     (setq clist (cons (list dcase) clist))))
  1680.           (forward-char 1))
  1681.         (kill-buffer (current-buffer))))
  1682.     (setq read-color-completion-table clist)))
  1683.   (completing-read prompt read-color-completion-table nil
  1684.            (and read-color-completion-table must-match)))
  1685.  
  1686. ;; #### The doc string for read-non-nil-coding system gets lost if we
  1687. ;; only include these if the mule feature is present.  Strangely,
  1688. ;; read-coding-system doesn't.
  1689.  
  1690. ;;(if (featurep 'mule)
  1691.  
  1692. (defun read-coding-system (prompt)
  1693.   "Read a coding-system (or nil) from the minibuffer.
  1694. Prompting with string PROMPT."
  1695.   (intern (completing-read prompt obarray 'find-coding-system t)))
  1696.  
  1697. (defun read-non-nil-coding-system (prompt)
  1698.   "Read a non-nil coding-system from the minibuffer.
  1699. Prompt with string PROMPT."
  1700.   (let ((retval (intern "")))
  1701.     (while (= 0 (length (symbol-name retval))
  1702.           (setq retval (intern (completing-read prompt obarray
  1703.                             'find-coding-system
  1704.                             t)))))
  1705.     retval))
  1706.  
  1707. ;;) ;; end of (featurep 'mule)
  1708.